home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / qtawk / slike.exp < prev    next >
Text File  |  1990-04-23  |  4KB  |  139 lines
  1. # QTAwk program to find words that "sound like" pre-determined words
  2. #
  3. BEGIN {
  4. # define words to find sound alikes for here
  5. #########################
  6.     pattrn = "pattern";
  7.     file = "file";
  8.     example = "example";
  9.  
  10.     pattrns = soundex(pattrn);
  11.     files = soundex(file);
  12.     examples = soundex(example);
  13. }
  14.  
  15. INITIAL {
  16.     print FILENAME;
  17. }
  18.  
  19.     {
  20.     local word;
  21.  
  22.     print FNR;
  23.     for ( i = 1 ; i <= NF ; i++ ) {
  24.     word = soundex($i);
  25.     switch ( word ) {   # Find sound alikes
  26.         case pattrns:
  27.         print FNR "R : " $i " sounds like "pattrn;
  28.         break;
  29.         case files:
  30.         print FNR "R : " $i " sounds like "file;
  31.         break;
  32.         case examples:
  33.         print FNR "R : " $i " sounds like "example;
  34.         break;
  35.     }
  36.     }
  37. }
  38.  
  39. # SOUNDIX Version 1.0
  40. #
  41. #  This program takes a character string such as a person's last
  42. #  name and translates it to a sound index.  This index can then be
  43. #  used by an application to perform phonetic (i.e. 'sounds-like')
  44. #  search. Algorithm found in D. Knuth, "Art of Computer Programming",
  45. #  Vol. 3, Page 391-392
  46. #
  47. #  Rules:
  48. #  =====
  49. #
  50. #  1) Retain the first letter of the name and drop all occurances of
  51. #     a, e, h, i, o, u, w, and y in other positions
  52. #  2) assign the following numbers to the remaining letters after the first
  53. #     bfpv    ==> 1
  54. #     cgjkqsxz    ==> 2
  55. #     dt    ==> 3
  56. #     l     ==> 4
  57. #     mn    ==> 5
  58. #     r     ==> 6
  59. #
  60. #  3) if two or more letters with the same code were adjacent in the original
  61. #     string (before step 1), omit all but the first
  62. #
  63. #  4) convert to the form "letter, digit, digit, digit" by adding trailing
  64. #     zeros (if there are less than three digits) by dropping rightmost
  65. #     digits (if there are more than three).
  66. #
  67. #
  68. #  Logic:
  69. #  =====
  70. #
  71. #  1) Uppercase the string
  72. #  2) Use suffix to first letter
  73. #  3) Change the following letters:
  74. #     R           to 6
  75. #     M,N          to 5
  76. #     L           to 4
  77. #     D,T          to 3
  78. #     C,G,J,K,Q,S,X,Z to 2
  79. #     B,F,P,V          to 1
  80. #     AEIOUYHW          to 0
  81. #     anything else   to 0
  82. #  4) Remove all adjacent duplicates
  83. #  5) Remove all zeros
  84. #
  85. #  Example: (  and  marks duplicates which are deleted )
  86. #  =======
  87. #              
  88. #  McClowry   -->   52240060   -->   5246 --> M246
  89. #  McLorey    -->   5240600    -->   5246 --> M246
  90. #             
  91. #  Schiller   -->   22004406   -->   246  --> S460
  92. #  Shilar     -->   200406     -->   246  --> S460
  93. #
  94. #  Rosen      -->   60205      -->   625  --> R250
  95. #  Rozin      -->   60205      -->   625  --> R250
  96. #
  97. #  Moynihan   -->   50050005   -->   555  --> M550
  98. #  Monnihan   -->   50550005   -->   555  --> M550
  99. #               
  100. #  Abete      -->   01030      -->   013  --> A130
  101. #  Abadey     -->   010300     -->   013  --> A130
  102. #
  103. #
  104. function soundex(str) {
  105.     local ldl;
  106.     local t_from = "|@#$%:;&*()_-+=![]'{}?/<>.~`^1234567890AEIOUYHWBFPVCGJKQSXZDTLMNR\\";
  107.     local t_to     = "000000000000000000000000000000000007000000000001111222222223345560";
  108.  
  109.     str = strupr(str);
  110.     ldl = substr(str,1,1);    # rule 1
  111.     gsub(/^[AEIOUYH]/,"7",str);     # reserve leading "AEIOUYH"
  112.     str = stran(str,t_to,t_from);   # rule 2
  113.  
  114.     gsub(/11+/,"1",str);    # replace duplicate 1's with single 1 rule 3
  115.     gsub(/22+/,"2",str);    # replace duplicate 2's with single 2 rule 3
  116.     gsub(/33+/,"3",str);    # replace duplicate 3's with single 3 rule 3
  117.     gsub(/44+/,"4",str);    # replace duplicate 4's with single 4 rule 3
  118.     gsub(/55+/,"5",str);    # replace duplicate 5's with single 5 rule 3
  119.     gsub(/66+/,"6",str);    # replace duplicate 6's with single 6 rule 3
  120.     gsub(/0+/,"",str);      # delete internal 0's, rule 1
  121.  
  122.     str = ldl substr(str,2);    # glue leading character back on front
  123.     if ( (ldl = length(str)) < 4 ) {
  124.     switch ( ldl ) {
  125.         case 1:
  126.         str ∩= "000";
  127.         break;
  128.         case 2:
  129.         str ∩= "00";
  130.         break;
  131.         case 3:
  132.         str ∩= "0";
  133.         break;
  134.     }
  135.     } else if ( ldl > 4 ) str = substr(str,1,4);
  136.  
  137.     return str;
  138. }
  139.